home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pibasy47.zip / FIXBRACK.PAS < prev    next >
Pascal/Delphi Source File  |  1987-11-11  |  7KB  |  177 lines
  1. (*$R-,V-,S-,F+*)
  2. PROGRAM FixBrack;
  3.  
  4. (*--------------------------------------------------------------------------*)
  5. (*                                                                          *)
  6. (*    Program:  FixBrack                                                    *)
  7. (*                                                                          *)
  8. (*    Purpose:  Neatens output of Dave Baldwin's INLINE assembler for       *)
  9. (*              Turbo Pascal so that the code is lined up properly.         *)
  10. (*                                                                          *)
  11. (*    Usage:    Compile and run in the usual way.  You will be prompted     *)
  12. (*              for the input and output file names.                        *)
  13. (*                                                                          *)
  14. (*--------------------------------------------------------------------------*)
  15.  
  16. TYPE
  17.    AnyStr           = STRING[255];
  18.    NameStr          = STRING[40];
  19.    Text_Buffer_Type = ARRAY[0..4095] OF CHAR;
  20.    
  21. VAR
  22.    OldObjFile  : TEXT;
  23.    OldObjName  : NameStr;
  24.    OldObjBuf   : Text_Buffer_Type;
  25.    NewObjFile  : TEXT;
  26.    NewObjName  : NameStr;
  27.    NewObjBuf   : Text_Buffer_Type;
  28.  
  29. (*--------------------------------------------------------------------------*)
  30. (*                     Dupl -- Duplicate a character n times                *)
  31. (*--------------------------------------------------------------------------*)
  32.  
  33. FUNCTION Dupl( Dup_char : Char; Dup_Count: INTEGER ) : AnyStr;
  34.  
  35. (*--------------------------------------------------------------------------*)
  36. (*                                                                          *)
  37. (*    Function: Dupl                                                        *)
  38. (*                                                                          *)
  39. (*    Purpose:  Duplicate a character n times                               *)
  40. (*                                                                          *)
  41. (*    Calling Sequence:                                                     *)
  42. (*                                                                          *)
  43. (*       Dup_String := Dupl( Dup_Char: Char; Dup_Count: INTEGER ): AnyStr;  *)
  44. (*                                                                          *)
  45. (*          Dup_Char   --- Character to be duplicated                       *)
  46. (*          Dup_Count  --- Number of times to duplicate character           *)
  47. (*          Dup_String --- Resultant duplicated string                      *)
  48. (*                                                                          *)
  49. (*          Note:  If Dup_Count <= 0, a null string is returned.            *)
  50. (*                                                                          *)
  51. (*    Calls:  None                                                          *)
  52. (*                                                                          *)
  53. (*                                                                          *)
  54. (*    Remarks:                                                              *)
  55. (*                                                                          *)
  56. (*       This routine could be programmed directly in Turbo as:             *)
  57. (*                                                                          *)
  58. (*          VAR                                                             *)
  59. (*             S    : AnyStr;                                               *)
  60. (*                                                                          *)
  61. (*          BEGIN                                                           *)
  62. (*                                                                          *)
  63. (*             FillChar( S[1], Dup_Count, Dup_Char );                       *)
  64. (*             S[0] := CHR( Dup_Count );                                    *)
  65. (*                                                                          *)
  66. (*             Dupl := S;                                                   *)
  67. (*                                                                          *)
  68. (*          END;                                                            *)
  69. (*                                                                          *)
  70. (*--------------------------------------------------------------------------*)
  71.  
  72. BEGIN (* Dupl *)
  73.  
  74. INLINE(
  75.   $8B/$4E/$06/           {         MOV       CX,[BP+6]  ; Pick up dup count}
  76.   $C4/$7E/$0A/           {         LES       DI,[BP+10] ; Result address}
  77.   $FC/                   {         CLD                  ; Set direction flag}
  78.   $88/$C8/               {         MOV       AL,CL      ; Get result length}
  79.   $AA/                   {         STOSB                ; Store result length}
  80.   $8B/$46/$08/           {         MOV       AX,[BP+8]  ; Get char to duplicate}
  81.   $F2/$AA);              {         REP       STOSB      ; Perform duplication}
  82.  
  83. END   (* Dupl *);
  84.  
  85. PROCEDURE Process_Files;
  86.  
  87. VAR
  88.    S       : AnyStr;
  89.    L       : INTEGER;
  90.    I       : INTEGER;
  91.    MaxBrack: INTEGER;
  92.  
  93. BEGIN (* Process_Filess *)
  94.  
  95.    ASSIGN    ( OldObjFile, OldObjName );
  96.    SetTextBuf( OldObjFile, OldObjBuf  );
  97.    RESET     ( OldObjFile );
  98.  
  99.    ASSIGN    ( NewObjFile, NewObjName );
  100.    SetTextBuf( NewObjFile, NewObjBuf  );
  101.    REWRITE   ( NewObjFile );
  102.  
  103.    WRITELN('Modifying ',OldObjName);
  104.  
  105.    MaxBrack := 0;
  106.  
  107.    REPEAT
  108.  
  109.       READLN( OldObjFile, S );
  110.  
  111.       I := POS( '{' , S );
  112.  
  113.       IF ( I > MaxBrack ) THEN
  114.          MaxBrack := I;
  115.  
  116.    UNTIL ( EOF( OldObjFile ) );
  117.  
  118.    RESET( OldObjFile );
  119.  
  120.    REPEAT
  121.  
  122.       READLN( OldObjFile, S );
  123.  
  124.       I := POS( '{' , S );
  125.  
  126.       IF ( I > MaxBrack ) THEN
  127.          MaxBrack := I;
  128.  
  129.       IF ( I = 0 ) THEN
  130.          WRITELN( NewObjFile , S )
  131.       ELSE
  132.          BEGIN
  133.             L := LENGTH( S );
  134.             WRITELN( NewObjFile, COPY( S, 1, I - 1 ),
  135.                      DUPL( ' ' , MaxBrack - I ), COPY( S, I, L - I + 1 ) );
  136.          END;
  137.  
  138.    UNTIL ( EOF( OldObjFile ) );
  139.  
  140.    CLOSE( OldObjFile );
  141.  
  142.    WRITELN;
  143.  
  144.    CLOSE( NewObjFile );
  145.  
  146. END   (* Process_Filess *);
  147.  
  148. PROCEDURE Get_File_Names;
  149.  
  150. BEGIN (* Get_File_Names *)
  151.  
  152.    IF ParamCount > 0 THEN
  153.       OldObjName := ParamStr( 1 )
  154.    ELSE
  155.       BEGIN
  156.          WRITE('File to read:  ');
  157.          READLN( OldObjName );
  158.       END;
  159.  
  160.    IF ParamCount > 1 THEN
  161.       NewObjName := ParamStr( 2 )
  162.    ELSE
  163.       BEGIN
  164.          WRITE('File to write: ');
  165.          READLN( NewObjName );
  166.       END;
  167.  
  168. END   (* Get_File_Names *);
  169.  
  170. BEGIN (* FixBrack *)
  171.  
  172.    Get_File_Names;
  173.  
  174.    Process_Files;
  175.  
  176. END   (* FixBrack *).
  177.